plot

Accumulative Distribution

ggplot(dt, aes(status_day5_num)) + stat_ecdf(geom = "step") +
    scale_x_continuous(limits=c(0.8, 8.8)
                       , breaks=1:8
                       , labels=levels(dt$status_day5)
                     , name="Numerical Day 5 Status")

Histogram by Group

ggplot(dt, aes(x=avg_daily_prone, fill=treatment)) +
    geom_histogram( color="#e9ecef", alpha=0.3, position = 'identity') +
    scale_fill_manual(values=c("#69b3a2", "#404080"))

Flowchart

library(Wu)
library(tgsify)
readRDS(file="df.RDS") %>%
    mutate(consort = case_when(
               iculos7d !=  "ICULOS 7d or more" ~ "2 2 ICU LOS less than 7 days"
             , is.na(inptrehabdc) ~ "3 2 Missing Values on Discharge Destination"
             , TRUE ~ "4 1 Study population"
           )) %>%
    le("consort") %>%
    two_column_consort("Total Records")

ggplot

Stacked Bar Charts

p <- ggplot(fdt2, aes(day_assessment_icu)) +
    geom_bar() +
    geom_bar(aes(fill = state_daily4_locf))
p

Stacked Bar Charts by Percentage

ggplot(fdt3, aes(x = factor(day_assessment_icu)
               , fill = state_daily4_locf)) +
    geom_bar(position="fill") +
    facet_wrap( ~ race_ethnicity, ncol=2)

Forest Plot

dt <- readRDS(file= "df.RDS")
dt <- dt[order(order.level)][!is.na(coef_value)]

## rename variables

dt$name <- c(
    "High Rehabilitation Service Ctr" ## "topquartileTop quartile"
  , "Female:Male" ## , "genderFemale"
  , "Age Child:Adolesent" ## , "age_groupChild"
  , "Age Infant:Adolesent" ## , "age_groupInfant"
  , "Age Neonate:Adolesent" ## , "age_groupNeonate"
  , "Ethnicity Hispanic/Latino:None" ## , "ethnicityHispanic or Latino"
  , "Ethnicity Other:None" ## , "ethnicityother"
  , "Payor Commercial:Government/Other" ## , "payor_classCommercial"
  , "Respiratory Season Oct-March" ## , "wintermonthOct thru March"
  , "Complex Chronic Conditions 1:0" ## , "ccc_composite1"
  , "Complex Chronic Conditions 2+:0" ## , "ccc_composite2+"
  , "Complex Chronic Condition Neuro" ## , "neuroYes"
  , "ICU LOS per Week" ## , "icu_los_in_weeks"
  , "CardSurg" ## , "card_surgCardSurg SVC"
  , "Respiratory Medical" ## , "resp_medicalRespMedical"
  , "Infection" ## , "infxnYes"
  , "ECMO Support" ## , "ecmoYes"
  , "Ventilation" ## , "ventYes"
  , "Prolonged Neruromuscular Blockage" ## , "nmb72hNMB charges for 3d or more"
  , "Prolonged Steroid Use" ## , "steroid72hSteroids for 72h or more"
)

dt <- dt[, num_rep := 22 - nchar(ci)
         ][, name_label := paste0(name, "    ", ci)
           ## ][, name_label := paste0(name, "    [", ci, "]")
]


dt$name <- factor(dt$name, levels = rev(dt$name))
dt$name_label <- factor(dt$name_label, levels = rev(dt$name_label))

dt[, .N, by = nchar(as.character(name_label))]


png(file="forestplot_irf.png", width = 2400, height = 1200, res = 300)
p <- ggplot(dt
          , aes(y = name_label
              , x = coef_value
              , xmin = coef_value_lower
              , xmax = coef_value_upper
                ))
p <- p + geom_vline(xintercept=1, color='grey', linetype='dashed',size=0.7)
p <- p + geom_errorbarh(height=0.2,color="#333333",size=0.8)
p <- p + geom_point(color = "#666666",size=1,shape=15)

p <- p + scale_x_continuous(limits=c(0,43), breaks=c(0,1,2,5), name='Adjusted Odds Ratio (IPR)')
## p <- p + scale_y_discrete(labels = "Y AXIS", sec.axis = dup.axis())
p <- p + ylab("")
p <- p + theme_bw()
p <- p + theme(axis.ticks = element_blank()
              , panel.grid.major = element_blank(),
               panel.grid.minor = element_blank()
               )
p <- p + coord_cartesian(xlim=c(0, 8))
p
dev.off()

Forest Plot Log Scale

png(file="forestplot_irf.png", width = 2400, height = 1200, res = 300)
p <- ggplot(dt
          , aes(y = name_label
              , x = coef_value
              , xmin = coef_value_lower
              , xmax = coef_value_upper
                ))
p <- p + geom_vline(xintercept=1, color='grey', linetype='dashed',size=0.7)
p <- p + geom_errorbarh(height=0.2,color="#333333",size=0.8)
p <- p + geom_point(color = "#666666",size=1,shape=15)

p <- p + scale_x_continuous(limits=c(0.1,4), breaks=c(0.1, 0.2, 0.5,1,2,3, 4), name='Adjusted Odds Ratio (IPR)')
## p <- p + scale_y_discrete(labels = "Y AXIS", sec.axis = dup.axis())
p <- p + ylab("")
p <- p + theme_bw()
p <- p + theme(axis.ticks = element_blank()
              , panel.grid.major = element_blank(),
               panel.grid.minor = element_blank()
               )
p <- p + coord_cartesian(xlim=c(0, 4)) +  coord_trans(x="log")
p
dev.off()


include_graphics("forestplot_irf.png")

Cell Plot

  • Plot discrete daily progression states
library(ggplot2)

dt <- data.table(
    id=1:10
  , day=rep(1:28, each=10)
  , state=sample(c("A", "B", "C", "D", "E", NA), 28 * 10, replace = TRUE)
)

dt <- dt[, state := factor(state, levels=c("A", "B", "C", "D", "E"), ordered = TRUE)]


clrs <- c("#2EAEE6"
        ## , "#2EE6CA"
        ## , "#2EE677"
        , "#37E62E"
        ## , "#8AE62E"
        , "#DCE62E"
        , "#E69C2E"
        , "#E6492E"
          ## , "#aaaaaa"
          )


ggplot(dt, aes(x=day, y=id)) +
    geom_tile(aes(fill=state, height=(1)), size=1) +
    scale_y_discrete() +
    scale_fill_manual(values = clrs)

linecolor <- "#999999"

ggplot(dt, aes(y=id,x=day)) +
    geom_point(aes(fill=state), colour="transparent", shape=22, size=4) +
    scale_fill_manual(values = clrs)+
    geom_line(aes(group = id), colour=linecolor, alpha=0.5) +
    scale_x_continuous(breaks=c(7, 14, 21, 28)) +
    scale_y_continuous(breaks=c(1, 3, 5, 7, 9)) +
    labs(title = "Title. \n Discrete Time Plot", x="Day", y="ID") +
    geom_vline(xintercept=c(7, 14), colour=linecolor,linetype="dashed") +
    geom_vline(xintercept=21,colour=linecolor,linetype="dashed") +
    theme(panel.background = element_rect(fill = "transparent")
        , plot.background = element_rect(fill = "transparent", color = NA)
        , panel.grid.major = element_blank()
        , panel.grid.minor = element_blank()
        , legend.background = element_rect(fill = "transparent")
        , legend.box.background = element_rect(fill = "transparent")
        , legend.position = 'top'
        , plot.margin=unit(c(1,2,1,2),"cm")
          ) +
    coord_fixed(ratio = 3 / 2
              , xlim = c(0.5, 28.5)
              , ylim = c(0.5, 10.5)
              , expand = FALSE) +
    guides(fill = guide_legend(nrow = 1))

Color

Hue Saturation Luminance (HSL)

  • fig.width=7 inch
  • fig.height=14 inch
  • dpi=300
library(ggplot2)

dt <- expand.grid(seq(0, 340, 20), seq(0, 100, 10), seq(0, 100, 10))
dt <- as.data.table(dt)
colnames(dt) <- c("Hue", "Saturation", "Luminance")
## dt <- dt[, clr := hcl(Hue, Chroma, Luminance)]
dt <- dt[, clr := hsv(Hue / 360, Saturation / 100, Luminance / 100)]
ggplot(dt, aes(x=Saturation, y=Luminance, colour=clr)) +
    geom_point(size=3) +
    scale_color_identity() +
    scale_x_continuous(breaks=seq(0, 100, 10)) +
    scale_y_continuous(breaks=seq(0, 100, 10)) +
    facet_wrap( ~ Hue, nrow=6)

plotly

Radar Chart

dt <- readRDS(file="df.RDS")

rl <- dt[, .(m_mmdhp=median(sqrt(mmdhp_score_imp), na.rm = TRUE)
           , m_js=median(edmcq_js_score_imp, na.rm = TRUE)
           , ms_clt=median(edmcq_js_score_imp, na.rm = TRUE)
           , ms_ldr=median(edmcq_ldr_score_imp, na.rm = TRUE)
           , m_eol=median(edmcq_eol_score_imp, na.rm = TRUE)
             )
       , by = list(gender_q3.factor)
         ][order(gender_q3.factor)]

rl$m_mmdhp2 <- rl$m_mmdhp


dms <- c("MMD-HP", "Job Strain"
       , "Safety Culture"
       , "Leadership Culture"
       , "End of Life"
       , "MMD-HP"
         )

opc <- 0.5
fig <- plot_ly(
    type = 'scatterpolar',
    fill = 'toself'
  )
fig <- fig %>%
  add_trace(
    r = t(rl[1, 2:7, drop = TRUE])
    , theta = dms
  , name = rl$gender_q3.factor[1]
  , opacity = opc
  )

fig <- fig %>%
  add_trace(
    r = t(rl[2, 2:7, drop = TRUE])
  , theta = dms
  , name = rl$gender_q3.factor[2]
  , opacity = opc
  )
fig <- fig %>%
  layout(
    polar = list(
      radialaxis = list(
        visible = T,
        range = c(0, 4)
      )
    )
  )

fig

Computing Environment

sessionInfo()

R version 4.0.3 (2020-10-10) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 18.04.5 LTS

Matrix products: default BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1

locale: [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
[5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=en_US.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] Wu_0.0.0.9000 flexdashboard_0.5.2 lme4_1.1-26
[4] Matrix_1.2-18 mgcv_1.8-33 nlme_3.1-149
[7] png_0.1-7 scales_1.1.1 nnet_7.3-14
[10] labelled_2.7.0 kableExtra_1.3.2 plotly_4.9.3
[13] gridExtra_2.3 ggplot2_3.3.3 DT_0.17
[16] tableone_0.12.0 magrittr_2.0.1 lubridate_1.7.9.2
[19] dplyr_1.0.4 plyr_1.8.6 data.table_1.13.6
[22] rmdformats_0.3.7 knitr_1.31

loaded via a namespace (and not attached): [1] Rcpp_1.0.6 lattice_0.20-41 tidyr_1.1.2 assertthat_0.2.1 [5] digest_0.6.27 R6_2.5.0 survey_4.0 evaluate_0.14
[9] highr_0.8 httr_1.4.2 pillar_1.4.7 rlang_0.4.10
[13] lazyeval_0.2.2 minqa_1.2.4 rstudioapi_0.13 nloptr_1.2.2.2
[17] jquerylib_0.1.3 rmarkdown_2.7 labeling_0.4.2 splines_4.0.3
[21] webshot_0.5.2 statmod_1.4.35 stringr_1.4.0 htmlwidgets_1.5.3 [25] munsell_0.5.0 compiler_4.0.3 xfun_0.21 pkgconfig_2.0.3
[29] htmltools_0.5.1.1 mitools_2.4 tidyselect_1.1.0 tibble_3.0.6
[33] bookdown_0.21 viridisLite_0.3.0 crayon_1.4.1 withr_2.4.1
[37] MASS_7.3-53 grid_4.0.3 jsonlite_1.7.2 gtable_0.3.0
[41] lifecycle_1.0.0 DBI_1.1.1 stringi_1.5.3 farver_2.0.3
[45] xml2_1.3.2 bslib_0.2.4 ellipsis_0.3.1 generics_0.1.0
[49] vctrs_0.3.6 boot_1.3-25 tools_4.0.3 forcats_0.5.1
[53] glue_1.4.2 purrr_0.3.4 hms_1.0.0 survival_3.2-7
[57] yaml_2.2.1 colorspace_2.0-0 rvest_0.3.6 haven_2.3.1
[61] sass_0.3.1